Euler’s Disk

Die Scheibe

Volumen

(X={r Cos[φ],r Sin[φ],z})//MatrixForm;

V=Integrate[ r,{z,0,d},{φ,0,2 π},{r,0,R}]

Schwerpunkt

m= V ρ

(S=(1/V)Integrate[ X,{z,-d/2,d/2},{φ,0,2 π},{r,0,R}])//MatrixForm

s=S[[3]]//FullSimplify

Trägheitstensor

Jf[i_,j_]=Integrate[ρ r((X.X)KroneckerDelta[i,j]-X.UnitVector[3,i]*X.UnitVector[3,j]),{z,-d/2,d/2},{φ,-π, π},{r,0,R}];
(J=Array[Jf,{3,3}])//MatrixForm

Eulerwinkel

Kartesische Koordinaten

(Kart={{1,0,0},{0,1,0},{0,0,1}})//MatrixForm

Transformationsmatrix

(rotZφ={{Cos[φ],Sin[φ],0},{-Sin[φ],Cos[φ],0},{0,0,1}})//MatrixForm;
(rotXθ={{1,0,0},{0,Cos[θ],Sin[θ]},{0,-Sin[θ],Cos[θ]}})//MatrixForm;
(rotZψ=rotZφ/.φ->ψ)//MatrixForm;
(Euler=rotZψ.rotXθ.rotZφ)//MatrixForm;

zeitabh={φ->φ[t],θ->θ[t],ψ->ψ[t], φ'-> φ'[t],θ'->θ'[t],θ''->θ''[t],ψ'->ψ'[t],x->x[t],x'->x'[t],y->y[t],y'->y'[t]};
(EulerT=Euler/.zeitabh)//MatrixForm

IEulerT=Transpose[EulerT]//FullSimplify;
IEulerT.EulerT//FullSimplify;

Winkelgeschwindigkeit

ω1=D[EulerT[[2]],t].(EulerT[[3]])//Simplify;
ω2=D[EulerT[[3]],t].(EulerT[[1]])//Simplify;
ω3=D[EulerT[[1]],t].(EulerT[[2]])//Simplify;
ωBs={ω1,ω2,ω3};
ωBs//MatrixForm

IEulerT.ωBs//FullSimplify//MatrixForm

ωx=(EulerT.Kart[[2]]).(D[EulerT.Kart[[3]],t])//FullSimplify;
ωy=(EulerT.Kart[[3]]).(D[EulerT.Kart[[1]],t])//FullSimplify;
ωz=(EulerT.Kart[[1]]).(D[EulerT.Kart[[2]],t])//FullSimplify;
ωIs={ωx,ωy,ωz};
ωIs//MatrixForm

Geometrie

ϵ=(Sqrt[(R^2)+((((d/2)))^2)]);
α=ArcTan[(d/(2R))];
r[t_]=ϵ Cos[θ[t]+α];
z[t_]=ϵ Sin[θ[t]+α];(*+d Cos[α]*)
M[t_]={0,0,z[t]};
P[t_]={-r[t]Cos[φ[t]],-r[t]Sin[φ[t]],0};
dis[t_]=P[t]-M[t];

(Sqrt[(P[t]-M[t]).(P[t]-M[t])])//FullSimplify

Lagrange

JBs={{a,0,0},{0,a,0},{0,0,c}};
JBs//MatrixForm

JIs=IEulerT.JBs.EulerT//FullSimplify;
JIs//MatrixForm

ρ=10;
g=9.81;
R=1;
d=0.1;
a=J[[1,1]];
c=J[[3,3]];

ℒ=(1/2)m (((D[z[t],t])^2))+(1/2)ωIs.JIs.ωIs-m g z[t]//FullSimplify

(*(1/(16 (Sqrt[4+((d^2)/(R^2))])))(-8 d g π R (Sqrt[(d^2)+4 (R^2)]) ρ (d Cos[θ[t]]+2 R Sin[θ[t]])+(Sqrt[4+((d^2)/(R^2))]) ((8 a+d π (R^2) ((d^2)+4 (R^2)) ρ-d π (R^2) ρ (((d^2)-4 (R^2)) Cos[2 θ[t]]+4 d R Sin[2 θ[t]])) ((θ'[t])^2)+4 (a+c+(-a+c) Cos[2 θ[t]]) ((φ'[t])^2)+16 c Cos[θ[t]] φ'[t] ψ'[t]+8 c ((ψ'[t])^2)))*)

Lagrange={
D[D[ℒ, θ'[t]],t]-D[ℒ,θ[t]]==0,
D[D[ℒ, φ'[t]],t]-D[ℒ,φ[t]]==0,
D[D[ℒ, ψ'[t]],t]-D[ℒ,ψ[t]]==0}//FullSimplify

sol[ω0_,θ0_]:=NDSolve[{Lagrange,θ[0]==θ0,θ'[0]==0,φ[0]==0,  φ'[0]==0,ψ[0]==0,  ψ'[0]==ω0},{θ[t],φ[t],ψ[t]},{t,0,100}]

Animation

oben=;
unten=;
Oben=ParametricPlot3D[{r Cos[φ],r Sin[φ],0.1},{φ,0,2π},{r,0,R},Mesh->False,TextureCoordinateFunction->({#1,#2}&),PlotStyle->Texture[oben]][[1]];
Rand=ParametricPlot3D[{R Cos[φ],R Sin[φ],h},{φ,0,2π},{h,0,d},Mesh->False,PlotStyle->Gray][[1]];
Unten=ParametricPlot3D[{r Cos[φ],r Sin[φ],0},{φ,0,2π},{r,0,R},Mesh->False,TextureCoordinateFunction->({#2,#1}&),PlotStyle->Texture[unten]][[1]];
Coin={Oben,Rand,Unten};
coin={{Brown,Cylinder[{{0,0,-(d/2)},{0,0,(d/2)}},R]},Arrow[{{0,0,(d/2)},{0,1,(d/2)}}]};
ground={LightBrown,Polygon[{{1.5,-1.5,0},{1.5,1.5,0},{-1.5,1.5,0},{-1.5,-1.5,0}}]};


Sol[t_]=sol[15,(π/2)-25.0α ];
θsol[t_]=θ[t]/.Sol[t];
EulerSol[t_]=EulerT/.Sol[t];
zsol[t_]=z[t]/.Sol[t];

Anim[t_]=Graphics3D[{Translate[GeometricTransformation[coin,EulerSol[t]],{0,0,zsol[t][[1]]}],ground},Boxed->False,ViewPoint->{-2,0,0.5},PlotRange->{{-1.5,1.5},{-1.5,1.5},{-0.5,2R+d}},Lighting->"Neutral"];

Plot[{θsol[t],α,(π/2)},{t,0,30},PlotStyle->{Automatic,Dashed,Dashed}]

Manipulate[
Anim[t]
,{t,0,30,AnimationRate->1,AnimationRunning->False,ControlType->Animator}]